home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / tpu-extras.el < prev    next >
Text File  |  1996-01-20  |  18KB  |  478 lines
  1. ;;; tpu-extras.el --- Scroll margins and free cursor mode for TPU-edt
  2.  
  3. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Rob Riepel <riepel@networking.stanford.edu>
  6. ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
  7. ;; Keywords: emulations
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;  Use the functions defined here to customize TPU-edt to your tastes by
  29. ;;  setting scroll margins and/or turning on free cursor mode.  Here's an
  30. ;;  example for your .emacs file.
  31.  
  32. ;;     (tpu-set-cursor-free)                   ; Set cursor free.
  33. ;;     (tpu-set-scroll-margins "10%" "15%")    ; Set scroll margins.
  34.  
  35. ;;  Scroll margins and cursor binding can be changed from within emacs using
  36. ;;  the following commands:
  37.  
  38. ;;     tpu-set-scroll-margins  or   set scroll margins
  39. ;;     tpu-set-cursor-bound    or   set cursor bound
  40. ;;     tpu-set-cursor-free     or   set cursor free
  41.  
  42. ;;  Additionally, Gold-F toggles between bound and free cursor modes.
  43.  
  44. ;;  Note that switching out of free cursor mode or exiting TPU-edt while in
  45. ;;  free cursor mode strips trailing whitespace from every line in the file.
  46.  
  47.  
  48. ;;; Details:
  49.  
  50. ;;  The functions contained in this file implement scroll margins and free
  51. ;;  cursor mode.  The following keys and commands are affected.
  52.  
  53. ;;       key/command   function                        scroll   cursor
  54.  
  55. ;;       Up-Arrow      previous line                     x        x
  56. ;;       Down-Arrow    next line                         x        x
  57. ;;       Right-Arrow   next character                             x
  58. ;;       Left-Arrow    previous character                         x
  59. ;;       KP0           next or previous line             x
  60. ;;       KP7           next or previous page             x
  61. ;;       KP8           next or previous screen           x
  62. ;;       KP2           next or previous end-of-line      x        x
  63. ;;       Control-e     current end-of-line                        x
  64. ;;       Control-h     previous beginning-of-line        x
  65. ;;       Next Scr      next screen                       x
  66. ;;       Prev Scr      previous screen                   x
  67. ;;       Search        find a string                     x
  68. ;;       Replace       find and replace a string         x
  69. ;;       Newline       insert a newline                  x
  70. ;;       Paragraph     next or previous paragraph        x
  71. ;;       Auto-Fill     break lines on spaces             x
  72.  
  73. ;;  These functions are not part of the base TPU-edt for the following
  74. ;;  reasons:
  75.  
  76. ;;  Free cursor mode is implemented with the emacs picture-mode functions.
  77. ;;  These functions support moving the cursor all over the screen, however,
  78. ;;  when the cursor is moved past the end of a line, spaces or tabs are
  79. ;;  appended to the line - even if no text is entered in that area.  In
  80. ;;  order for a free cursor mode to work exactly like TPU/edt, this trailing
  81. ;;  whitespace needs to be dealt with in every function that might encounter
  82. ;;  it.  Such global changes are impractical, however, free cursor mode is
  83. ;;  too valuable to abandon completely, so it has been implemented in those
  84. ;;  functions where it serves best.
  85.  
  86. ;;  The implementation of scroll margins adds overhead to previously
  87. ;;  simple and often used commands.  These commands are now responsible
  88. ;;  for their normal operation and part of the display function.  There
  89. ;;  is a possibility that this display overhead could adversely affect the
  90. ;;  performance of TPU-edt on slower computers.  In order to support the
  91. ;;  widest range of computers, scroll margin support is optional.
  92.  
  93. ;;  It's actually not known whether the overhead associated with scroll
  94. ;;  margin support is significant.  If you find that it is, please send
  95. ;;  a note describing the extent of the performance degradation.  Be sure
  96. ;;  to include a description of the platform where you're running TPU-edt.
  97. ;;  Send your note to the address provided by Gold-V.
  98.  
  99. ;;  Even with these differences and limitations, these functions implement
  100. ;;  important aspects of the real TPU/edt.  Those who miss free cursor mode
  101. ;;  and/or scroll margins will appreciate these implementations.
  102.  
  103. ;;; Code:
  104.  
  105.  
  106. ;;;  Gotta have tpu-edt
  107.  
  108. (require 'tpu-edt)
  109.  
  110.  
  111. ;;;  Customization variables
  112.  
  113. (defconst tpu-top-scroll-margin 0
  114.   "*Scroll margin at the top of the screen.
  115. Interpreted as a percent of the current window size.")
  116. (defconst tpu-bottom-scroll-margin 0
  117.   "*Scroll margin at the bottom of the screen.
  118. Interpreted as a percent of the current window size.")
  119.  
  120. (defvar tpu-backward-char-like-tpu t
  121.   "*If non-nil, in free cursor mode backward-char (left-arrow) works
  122. just like TPU/edt.  Otherwise, backward-char will move to the end of
  123. the previous line when starting from a line beginning.")
  124.  
  125.  
  126. ;;;  Global variables
  127.  
  128. (defvar tpu-cursor-free nil
  129.   "If non-nil, let the cursor roam free.")
  130.  
  131.  
  132. ;;;  Hooks  --  Set cursor free in picture mode.
  133. ;;;             Clean up when writing a file from cursor free mode.
  134.  
  135. (add-hook 'picture-mode-hook 'tpu-set-cursor-free)
  136.  
  137. (defun tpu-write-file-hook nil
  138.   "Eliminate whitespace at ends of lines, if the cursor is free."
  139.   (if (and (buffer-modified-p) tpu-cursor-free) (picture-clean)))
  140.  
  141. (or (memq 'tpu-write-file-hook write-file-hooks)
  142.     (setq write-file-hooks
  143.       (cons 'tpu-write-file-hook write-file-hooks)))
  144.  
  145.  
  146. ;;;  Utility routines for implementing scroll margins
  147.  
  148. (defun tpu-top-check (beg lines)
  149.   "Enforce scroll margin at the top of screen."
  150.   (let ((margin     (/ (* (window-height) tpu-top-scroll-margin) 100)))
  151.     (cond ((< beg margin) (recenter beg))
  152.       ((< (- beg lines) margin) (recenter margin)))))
  153.  
  154. (defun tpu-bottom-check (beg lines)
  155.   "Enforce scroll margin at the bottom of screen."
  156.   (let* ((height (window-height))
  157.      (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100)))
  158.      ;; subtract 1 from height because it includes mode line
  159.      (difference (- height margin 1)))
  160.     (cond ((> beg difference) (recenter beg))
  161.       ((> (+ beg lines) difference) (recenter (- margin))))))
  162.  
  163.  
  164. ;;;  Movement by character
  165.  
  166. (defun tpu-forward-char (num)
  167.   "Move right ARG characters (left if ARG is negative)."
  168.   (interactive "p")
  169.   (if tpu-cursor-free (picture-forward-column num) (forward-char num)))
  170.  
  171. (defun tpu-backward-char (num)
  172.   "Move left ARG characters (right if ARG is negative)."
  173.   (interactive "p")
  174.   (cond ((not tpu-cursor-free)
  175.      (backward-char num))
  176.     (tpu-backward-char-like-tpu
  177.      (picture-backward-column num))
  178.     ((bolp)
  179.      (backward-char 1)
  180.      (picture-end-of-line)
  181.      (picture-backward-column (1- num)))
  182.     (t
  183.      (picture-backward-column num))))
  184.  
  185.  
  186. ;;;  Movement by line
  187.  
  188. (defun tpu-next-line (num)
  189.   "Move to next line.
  190. Prefix argument serves as a repeat count."
  191.   (interactive "p")
  192.   (let ((beg (tpu-current-line)))
  193.     (if tpu-cursor-free (or (eobp) (picture-move-down num))
  194.       (next-line-internal num))
  195.     (tpu-bottom-check beg num)
  196.     (setq this-command 'next-line)))
  197.  
  198. (defun tpu-previous-line (num)
  199.   "Move to previous line.
  200. Prefix argument serves as a repeat count."
  201.   (interactive "p")
  202.   (let ((beg (tpu-current-line)))
  203.     (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num)))
  204.     (tpu-top-check beg num)
  205.     (setq this-command 'previous-line)))
  206.  
  207. (defun tpu-next-beginning-of-line (num)
  208.   "Move to beginning of line; if at beginning, move to beginnin